home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / math / gle-3.000 / gle-3 / gle / run.c < prev    next >
C/C++ Source or Header  |  1995-02-07  |  27KB  |  1,171 lines
  1. #include "all.h"
  2.  
  3. #include <math.h>
  4.  
  5. #include "mygraph.h"   /* Prototypes for all the graph routines */
  6. int text_def(char *ss);
  7. int g_psarrow(double x1, double y1, double x2, double y2, int flag);
  8. int g_arrowline(double dx, double dy, int flag);
  9. int g_arrowpoints(double cx,double cy,double dx,double dy, double *ax1,double *ay1
  10.     ,double *ax2,double *ay2, double *nx, double *ny);
  11. int name_join(char *a, char *b, int j);
  12. int box_start(void);
  13. int box_end(void);
  14. int g_arrow(double dx, double dy);
  15. int run_bigfile(char *ss);
  16. #define MAXBOX 10
  17. extern int this_line;
  18. extern int trace_on;
  19. static char *box_name[MAXBOX];
  20. static double box_y1[MAXBOX], box_x1[MAXBOX], box_y2[MAXBOX], box_x2[MAXBOX];
  21. static int box_nobox[MAXBOX];
  22. static int32 box_fill[MAXBOX];
  23. static double box_add[MAXBOX];
  24. static int path_clip[4],path_stroke[4];
  25. static int32 path_fill[4];
  26. static double path_x[4],path_y[4];
  27. static int npath,nbox;
  28. int done_open;
  29. #define true (!false)
  30. #define false 0
  31. /*---------------------------------------------------------------------------*/
  32. /* gle FILE io stuff.  (fopen fclose fread fwrite) */
  33. #define F_MAXCHAN 5
  34. static int f_end[F_MAXCHAN];
  35. static char *f_buff[F_MAXCHAN];
  36. static FILE *f_chan[F_MAXCHAN];
  37. static int f_read[F_MAXCHAN];
  38. static char *f_nexttok[F_MAXCHAN];
  39. int f_getchan(void);
  40. void f_readahead(int chn);
  41. int f_testchan(int chn);
  42. void siffree(char **s);
  43. void f_getline(int chn);
  44. char *f_gettok(int chn);
  45. static int chn;
  46. int f_eof(int chn);
  47. char *f_getnext(int chn);
  48. /*---------------------------------------------------------------------------*/
  49. /* pos=   Offset to find the data            */
  50. /* idx=   For switches, which can only have one value.     */
  51. /* The pos is the order the items will be placed in the pcode */
  52. /*
  53. /* Switches     int32     placed in directly, 1 present, 0 not present
  54. /* expressions     LONG*     pointed to, 0 if not present.
  55. /* color/fill    LONG*     Pointer to exp 0 if not present.
  56. /* marker    LONG*    Pointer to exp 0 if not present.
  57. /* lstyle     LONG*    Pointer to exp 0 if not present.
  58. /* font     int32*     Pointer to string expression.
  59. */
  60.  
  61. extern char *mainkey[];
  62. extern int gle_debug;
  63. int can_fillpath;
  64. int init_run_done;
  65.  
  66. #define readval(x) eval(pcode,&cp,&x,ostr,&otyp)
  67. #define readxy(x,y) {eval(pcode,&cp,&x,ostr,&otyp);eval(pcode,&cp,&y,ostr,&otyp);}
  68. #define readstr(s) eval(pcode,&cp,&x,s,&otyp)
  69. #define readlong(i) i = *(pcode+cp++)
  70. #define readvalp(x,p) {zzcp=0; eval(p,&zzcp,&x,ostr,&otyp);}
  71. #define dbg if ((gle_debug & 16)>0)
  72. static int for_level,for_skip,for_loop,if_findelse,if_findendif,if_level;
  73. void for_init(void)
  74. {
  75.     for_loop = 0;
  76.     for_level = 0;
  77.     for_skip = 0;
  78.     if_findelse = 0;
  79.     if_findendif = 0;
  80.     if_level = 0;
  81. }
  82. /*---------------------------------------------------------------------------*/
  83. /* Input is pcode, output is text equiv.*/
  84. do_pcode(int *srclin, int32 *pcode, int plen, int *pend)
  85. /* srclin = The source line number */
  86. /* pcode =  a pointer to the pcode output buffer */
  87. /* plne =   a pointer to the length of the pcode output */
  88. {
  89.     double oval;
  90.     union {double d; int32 l; int32 ll[2];} both;
  91.     int otyp,cp=0,i,zzcp;
  92.     static double loopstep[30];
  93.     static int loopadr[30],nloop;
  94.     double lll,rrr,uuu,ddd;
  95.     char ostr[255];
  96.     char *pss;
  97.     char *zzz;
  98.     int p;
  99.     union ppboth {int32 l; short s[2];} bth;
  100.     double x,y,sx,sy,ox,oy,x1,y1,x2,y2,x3,y3,a1,a2,r,z;
  101.     int t,j,jj,ptr,ptr_fill,mask_just,mask_nostroke,marrow;
  102.     static char ss[255],ss2[80];
  103.  
  104.  
  105.     if (!init_run_done) {
  106.         init_run_done = true;
  107.         g_get_type(ss);
  108.         if (strstr(ss,"FILLPATH")!=NULL) can_fillpath = true;
  109.     }
  110.  
  111.     this_line = *srclin;
  112.     /* dbg gprint("Gle debug %d \n ",gle_debug);
  113.     dbg gprint("PP> ");
  114.     dbg for (i=0; i<plen; i++) {
  115.         bth.l = *(pcode+i);
  116.         dbg gprint("%ld  ",bth.l);
  117.     }
  118.     dbg gprint("\n");
  119.     */
  120.     dbg {
  121.         gprint("HEX> ");
  122.         for (i=0; i<plen; i++) {
  123.             bth.l = *(pcode+i);
  124.             gprint("%lx  ",bth.l);
  125.             if (i==14) gprint("\n");
  126.         }
  127.         gprint("\n");
  128.     }
  129.  
  130.     if (plen==0) return;
  131.     if (*(pcode)==0) return;
  132.     p = *(pcode+((cp)++));
  133.     cmd_name(p,&pss);
  134.     dbg gprint("Command %d {%s} \n",p,pss);
  135.     sprintf(ss,"Command %d {%s} \n",p,pss);
  136.     g_source(ss);
  137.     if (if_findelse) {
  138.         dbg gprint("SKIP in skip findelse \n");
  139.         switch (p) {
  140.             case 13 : /* else */
  141.                 if (if_level==0) {
  142.                     if_findelse = false;
  143.                 }
  144.                 break;
  145.             case 14 : /* end xxx */
  146.                 readlong(jj);
  147.                 if (jj==6) { /* end if */
  148.                     if (if_level==0) {
  149.                         if_findelse = false;
  150.                     } else if_level--;
  151.                 }
  152.                 break;
  153.             case 22 : /* if */
  154.                 if_level++;
  155.                 break;
  156.         }
  157.         return;
  158.     }
  159.     if (if_findendif) {
  160.         dbg gprint("SKIP, findendif \n");
  161.         switch (p) {
  162.             case 14 : /* end xxx */
  163.                 readlong(jj);
  164.                 if (jj==6) { /* end if */
  165.                     if (if_level==0) {
  166.                         if_findendif = false;
  167.                     } else if_level--;
  168.                 } else gprint("Wrong end %d \n",jj);
  169.                 break;
  170.             case 22 : /* if */
  171.                 if_level++;
  172.                 break;
  173.         }
  174.         return;
  175.     }
  176.     if (for_skip ) {
  177.         switch (p) {
  178.             case 47: /* until */
  179.             case 18 : /* for */
  180.                 for_level++;
  181.                 break;
  182.             case 30 : /* next */
  183.                 if (for_level==0) {
  184.                     for_skip = false;
  185.                 } else for_level--;
  186.                 break;
  187.         }
  188.         return;
  189.     }
  190.     if (!done_open) {
  191.         if (p!=42 && p!=53 && p!=0) {
  192.             gprint("No SIZE command at top of graph, assuming 10cm by 10cm\n");
  193.             g_open(10.0,10.0);
  194.             done_open = true;
  195.             return;
  196.         }
  197.     }
  198.     switch (p) {
  199.       case 53: /* comment */
  200.       case 0: /* blank line */
  201.         break;
  202.       case 1:  /* ALINE x y ARROW both | start | end */
  203.         readval(x);
  204.         readval(y);
  205.         dbg gprint("x=%f, y=%f \n",x,y);
  206.         marrow = *(pcode + (cp++));
  207.         dbg gprint("arrow mask %d \n",marrow);
  208.         g_arrowline(x,y,marrow);
  209.         break;
  210.       case 2:  /* AMOVE */
  211.         readval(x);
  212.         readval(y);
  213.         g_move(x,y);
  214.         break;
  215.       case 3: /* ARC */
  216.         readval(r);
  217.         readxy(a1,a2);
  218.         g_get_xy(&ox,&oy);
  219.  
  220.         ptr = *(pcode + cp); /* cx,cy */
  221.         if (ptr) {
  222.             readvalp(x,pcode + cp + ptr);
  223.             ox+=x;
  224.         }
  225.         ptr = *(pcode + cp + 1); /* cx,cy */
  226.         if (ptr) {
  227.             readvalp(y,pcode + cp + ptr);
  228.             oy+=y;
  229.         }
  230.         g_arc(r,a1,a2,ox,oy);
  231.         break;
  232.       case 4: /* ARCTO */
  233.         readxy(x1,y1);
  234.         readxy(x2,y2);
  235.         readval(r);
  236.         g_get_xy(&ox,&oy);
  237.         g_arcto(x1+ox,y1+oy,x2+ox+x1,y2+oy+y1,r);
  238.         break;
  239.       case 51: /* Assignment  var=exp */
  240.         readlong(jj);
  241.         readval(x);
  242.         if (otyp==1) var_set(jj,x);
  243.         if (otyp==2) var_setstr(jj,ostr);
  244.         break;
  245.       case 5:  /* BEGIN box | path | scale | rotate | EXTERNAL */
  246.         g_flush();
  247.         i = *(pcode + cp++);
  248.         dbg gprint(" begin %d \n",i);
  249.         switch (i) {
  250.             case 1: /* PATH stroke fill clip */
  251.                 npath++;
  252.                 g_get_xy(&path_x[npath],&path_y[npath]);
  253.                 path_stroke[npath] = *(pcode + cp);
  254.                 ptr = *(pcode + ++cp);
  255.                 path_fill[npath] = 0;
  256.                 if (ptr) {
  257.                     readvalp(z,pcode+cp+ptr);
  258.                     memcpy(&path_fill[npath],&z,4);
  259.                 }
  260.                 path_clip[npath] = *(pcode + ++cp);
  261.                 g_set_path(true);
  262.                 g_newpath();
  263.                 break;
  264.             case 2: /* BOX   add,fill,nobox,name */
  265.                 box_start();
  266.                 ptr = *(pcode + cp);
  267.                 if (ptr) readvalp(box_add[nbox],pcode+cp+ptr);
  268.                 ptr = *(pcode + ++cp);
  269.                 if (ptr) {
  270.                     readvalp(z,pcode+cp+ptr);
  271.                     memcpy(&box_fill[nbox],&z,4);
  272.                 }
  273.                 box_nobox[nbox] = *(pcode + ++cp);
  274.                 ptr = *(pcode + ++cp);
  275.                 if (ptr) {
  276.                     readvalp(z,pcode+cp+ptr);
  277.                     box_name[nbox] = sdup(ostr);
  278.                 }
  279.                 break;
  280.             case 3: /* SCALE */
  281.                 readxy(x,y);
  282.                 g_gsave();
  283.                 g_scale(x,y);
  284.                 break;
  285.             case 21: /* shear */
  286.                 readxy(x,y);
  287.                 g_gsave();
  288.                 g_shear(x,y);
  289.                 break;
  290.             case 4: /* ROTATE */
  291.                 readval(x);
  292.                 g_gsave();
  293.                 g_rotate(x);
  294.                 break;
  295.             case 5: /* TRANSLATE */
  296.                 readval(x); readval(y);
  297.                 g_gsave();
  298.                 g_translate(x,y);
  299.                 g_rmove(0.0,0.0);
  300.                 break;
  301.             case 6: /* if */
  302.             case 7: /* sub */
  303.                 gprint("odd begin %d\n",i);
  304.                 break;
  305.             case 8: /* name */
  306.                 box_start();
  307.                 box_nobox[nbox] = true;
  308.                 readval(z);
  309.                 box_name[nbox] = sdup(ostr);
  310.                 break;
  311.             case 9: /* text */
  312.                 ptr = *(pcode + cp);
  313.                 z = 0;
  314.                 if (ptr) readvalp(z,pcode+cp+ptr);
  315.                 begin_text(srclin,pcode,&cp,z);
  316.                 break;
  317.             case 18: /* tab  (tabbing, table) */
  318.                 begin_tab(srclin,pcode,&cp);
  319.                 break;
  320.             case 10: /* graph */
  321.                 begin_graph(srclin,pcode,&cp);
  322.                 break;
  323.             case 11: /* xaxis */
  324.             case 12: /* yaxis */
  325.             case 13: /* x2axis */
  326.             case 14: /* y2axis */
  327.                 break;
  328.             case 16: /* KEY */
  329.                 begin_key(srclin,pcode,&cp);
  330.                 break;
  331.             case 19: /* begin  clip */
  332.                 g_beginclip();
  333.                 break;
  334.             case 17: /* ORIGIN */
  335.                 g_gsave();
  336.                 g_get_xy(&x,&y);
  337.                 g_translate(x,y);
  338.                 g_move(0.0,0.0);
  339.                 break;
  340.             default: /* error  */
  341.                 gprint("Error, illegal begin option %d \n",i);
  342.                 break;
  343.         }
  344.         break;
  345.       case 6: /* BEZIER */
  346.         readxy(x1,y1);
  347.         readxy(x2,y2);
  348.         readxy(x3,y3);
  349.         g_bezier(x1,y1,x2,y2,x3,y3);
  350.         break;
  351.       case 7:  /* BOX x y left|center|right FILL fexp NAME string */
  352.         readval(x);
  353.         readval(y);
  354.         g_get_xy(&ox,&oy);
  355.         x += ox;
  356.         y += oy;
  357.         dbg gprint("x=%f, y=%f \n",x,y);
  358.         mask_just = *(pcode + cp++);
  359.         g_dojust(&ox,&oy,&x,&y,mask_just);
  360.  
  361.         mask_nostroke = *(pcode + cp);
  362.         ptr_fill = *(pcode + ++cp);
  363.         if (ptr_fill) {
  364.             readvalp(z,pcode + cp + ptr_fill);
  365.             memcpy(&both.d,&z,sizeof(z));
  366.             g_set_fill(both.l);
  367.             g_box_fill(ox,oy,x,y);
  368.         }
  369.         if (!mask_nostroke)
  370.             g_box_stroke(ox,oy,x,y);
  371.         ptr = *(pcode + ++cp); /* name */
  372.         if (ptr) {
  373.             readvalp(z,pcode + cp + ptr);
  374.             name_set(ostr,ox,oy,x,y);
  375.         }
  376.         dbg gprint("justify mask %d ",mask_just);
  377.         dbg gprint("nostroke mask %d ",mask_nostroke);
  378.         dbg gprint("fill pointer %d \n",ptr_fill);
  379.         break;
  380.       case 52:  /* CALL or @   (nope, do this inside ASSIGN */
  381.         readval(r);
  382.         break;
  383.       case 8:  /* CIRCLE */
  384.         readval(r);
  385.         g_get_xy(&ox,&oy);
  386.         sx = ox; sy = oy;
  387.         mask_just = *(pcode + cp++);
  388.         x = ox + r;
  389.         y = oy + r;
  390.         g_dojust(&ox,&oy,&x,&y,mask_just);
  391.         g_move(ox,oy);
  392.         mask_nostroke = *(pcode + cp++);
  393.         ptr_fill = *(pcode + cp);
  394.         if (ptr_fill) {
  395.             readvalp(z,pcode + cp + ptr_fill);
  396.             memcpy(&both.l,&z,4);
  397.             g_set_fill(both.l);
  398.             g_circle_fill(r);
  399.         }
  400.         if (!mask_nostroke)
  401.             g_circle_stroke(r);
  402.         g_move(sx,sy);
  403.         break;
  404.       case 9: /* CLOSEPATH */
  405.         g_closepath();
  406.         break;
  407.       case 10: /* CURVE  x y x y ...  change to BEGIN CURVE ... END CURVE */
  408.         g_curve(pcode+cp);
  409.         break;
  410.       case 11: /* DEFINE  MARKER name  subname */
  411.         break;
  412.       case 12: /* DFONT */
  413.         readstr(ss);
  414.         g_dfont(ss);
  415.         break;
  416.       case 13: /* ELSE */
  417.         if_findendif = true;
  418.         break;
  419.       case 14: /* END */
  420.         readlong(jj);
  421.         switch (jj) {
  422.           case 1: /* end path  (stroke,fill,clip) */
  423.             if (path_fill[npath]!=0) {
  424.                 g_set_fill(path_fill[npath]);
  425.                 g_fill();
  426.             }
  427.             if (path_stroke[npath]==true) g_stroke();
  428.             if (path_clip[npath]==true) g_clip();
  429.             if (npath==0) {
  430.                 gprint("Too many end path's \n");
  431.                 break;
  432.             }
  433.             g_move(path_x[npath],path_y[npath]);
  434.             npath--;
  435.             g_set_path(false);
  436.             break;
  437.           case 2: /* end box */
  438.             box_end();
  439.             break;
  440.           case 3: /* end scale */
  441.           case 21: /* end shear */
  442.           case 4: /* end rotate */
  443.           case 5: /* end translate */
  444.             g_grestore();
  445.             break;
  446.           case 6: /* end if */
  447.             /* do nothing,  all done elsewhere I think?? */
  448.             break;
  449.           case 8: /* end name */
  450.             box_end();
  451.             break;
  452.           case 19: /* clip */
  453.             g_endclip();
  454.             break;
  455.           case 18: /* tab */
  456.           case 9: /* text */
  457.             break;
  458.           case 17: /* end origin */
  459.             g_grestore();
  460.             break;
  461.            default :
  462.             gprint("Not a valid end %d \n",jj);
  463.         }
  464.         break;
  465.       case 15: /* FCLOSE */
  466.         readval(x);
  467.         chn = x;
  468.         chn = f_testchan(chn);
  469.         if (f_chan[chn]!=NULL) fclose(f_chan[chn]);
  470.         f_chan[chn] = NULL;
  471.         siffree(&f_buff[chn]);
  472.         siffree(&f_nexttok[chn]);
  473.         f_buff[chn] = NULL;
  474.         break;
  475.       case 16: /* FILL */
  476.         g_fill();
  477.         break;
  478.       case 61 : /* fread CHAN a$ x   */
  479.       case 62 : /* freadln */
  480.         readlong(t);
  481.         if (t!=49) gprint("FREAD, PCODE ERROR, %d  cp %d plen %d\n",t,cp,plen);
  482.         readlong(i);
  483.         readlong(t);
  484.         var_get(i,&x);
  485.         chn = x;
  486.         chn = f_testchan(chn);
  487.         if (p==61 && cp>=plen) gprint("FREAD requires at least two parameters\n");
  488.         while (cp<plen) {
  489.             readlong(t);
  490.             if (t!=49) gprint("FREAD2, PCODE ERROR, %d  cp %d plen %d\n",t,cp,plen);
  491.             readlong(i); /* variable number */
  492.             readlong(t); /* type of variable */
  493.             if (t==1) {
  494.                 x = atof(f_gettok(chn));
  495.                 var_set(i,x);
  496.             } else {
  497.                 var_setstr(i,f_gettok(chn));
  498.             }
  499.         }
  500.         if (p==62) f_getline(chn);
  501.         break;
  502.       case 63 : /* fwrite */
  503.       case 64 : /* fwriteln */
  504.         strcpy(ss2,"");
  505.         readlong(t);
  506.         readlong(t);
  507.         readval(x);
  508.         chn = x;
  509.         chn = f_testchan(chn);
  510.         if (f_read[chn]==0) gprint("You cannot WRITE from a file open for READ {#%d %d} \n",chn,f_read[chn]);
  511.         while (cp<plen) {
  512.             readlong(t);
  513.             if (t!=49) gprint("WRITE, PCODE ERROR, %d  cp %d plen %d\n",t,cp,plen);
  514.             readlong(t);
  515.             if (t==1) {
  516.                 readval(x);
  517.                 sprintf(ss,"%g ",x);
  518.             } else readstr(ss);
  519.             strcat(ss2,ss);
  520.         }
  521.         if (p==64) strcat(ss2,"\n");
  522.         fprintf(f_chan[chn],"%s",ss2);
  523.         break;
  524.       case 17: /* FOPEN "a.a" inchan read|write */
  525.         readstr(ss);
  526.         readlong(i); /* channel variable */
  527.         readlong(jj); /* 0 = read, 1 = write */
  528.         chn = f_getchan();
  529.         f_read[chn] = jj;
  530.         var_set(i,chn);
  531.         if (f_chan[chn]!=NULL) fclose(f_chan[chn]);
  532.         if (jj==0) f_chan[chn] = fopen(ss,"r");
  533.         else     f_chan[chn] = fopen(ss,"w");
  534.         if (f_chan[chn]==NULL) {
  535.              gprint("Can't open {%s}  \n",ss);
  536.             f_end[chn] = true;
  537.             break;
  538.         }
  539.         dbg gprint("Opened {%s} chan %d, access %d  vari %d \n",ss,chn,jj,i);
  540.         f_end[chn] = false;
  541.         if (f_read[chn]==0) f_readahead(chn);
  542.         break;
  543.       case 18: /* FOR   v,exp,exp,op,exp */
  544.         if (for_loop) {
  545.             readlong(jj);
  546.             readval(x);
  547.             readval(y);
  548.             var_get(jj,&x);
  549.             x = x + loopstep[nloop];
  550.             var_set(jj,x);
  551.             var_get(jj,&x);
  552.             dbg gprint("got back %f \n",x);
  553.             if ( (x > y  && loopstep[nloop]>=0) ||
  554.                  (y > x  && loopstep[nloop]<=0) ) {
  555.                 for_skip = true;
  556.                 nloop--;
  557.             }
  558.             for_loop = false;
  559.             break;
  560.         }
  561.         loopadr[++nloop] = *srclin;
  562.         readlong(jj);      /* variable */
  563.         readval(x);
  564.         readval(y);
  565.         var_set(jj,x);
  566.         loopstep[nloop] = 1;
  567.         p = *(pcode + cp);
  568.         if (p) {
  569.             readvalp(z,pcode + cp + p);
  570.             loopstep[nloop] = z;
  571.         }
  572.         break;
  573.       case 19: /* GOTO */
  574.       case 20: /* GSAVE */
  575.         g_gsave();
  576.         break;
  577.       case 54: /* GRESTORE */
  578.         g_grestore();
  579.         break;
  580.       case 21: /* ICON */
  581.         break;
  582.       case 22: /* IF EXP */
  583.         readval(x);
  584.         dbg gprint("If expression = %f \n",x);
  585.         if (x==0) if_findelse = true;    /* exp was false */
  586.         break;
  587.       case 23: /* INCLUDE (done in pass,  already included) */
  588.         break;
  589.       case 24: /* INPUT */
  590.       case 25: /* JOIN  str1,type,str2 */
  591.         {
  592.             char ss1[90];
  593.             readval(z);
  594.             strcpy(ss1,ostr);
  595.             readlong(jj);
  596.             readval(z);
  597.             name_join(ss1,ostr,(int) jj);
  598.         }
  599.         break;
  600.       case 26: /* MARKER */
  601.         readval(x);
  602.         memcpy(&both.d,&x,sizeof(x));
  603.         jj = both.l;
  604.         g_get_hei(&z);
  605.         y = 1;
  606.         if (*(pcode+cp)!=0) readval(y);
  607.         y = y * z;
  608.         g_marker((int) both.l,y);
  609.         break;
  610.       case 27: /* MOVE  name */
  611.         readval(z);
  612.         name_get(ostr,&ox,&oy,&x,&y);
  613.         x = ox;
  614.         y = oy;
  615.         g_dojust(&ox,&oy,&x,&y,jj);
  616.         g_move(x+(x-ox),y+(y-oy));
  617.         break;
  618.       case 28: /* NARC */
  619.         readval(r);
  620.         readxy(a1,a2);
  621.         g_get_xy(&ox,&oy);
  622.         ptr = *(pcode + cp); /* cx,cy */
  623.         if (ptr) {
  624.             readvalp(x,pcode + cp + ptr);
  625.             ox+=x;
  626.         }
  627.         ptr = *(pcode + cp + 1); /* cx,cy */
  628.         if (ptr) {
  629.             readvalp(y,pcode + cp + ptr);
  630.             oy+=y;
  631.         }
  632.         g_narc(r,a1,a2,ox,oy);
  633.  
  634.         break;
  635.       case 29: /* NEWPATH */
  636.         g_newpath();
  637.         break;
  638.       case 30:  /* NEXT */
  639.         if (nloop==0) {
  640.             gprint("Next without for\n");
  641.             break;
  642.         }
  643.         *srclin = loopadr[nloop]-1;
  644.         dbg gprint("%FOR   Setting line back to %d  nloop %d \n ",*srclin,nloop);
  645.         for_loop = true;
  646.         break;
  647.       case 31: /* PIE ,, not implemented yet */
  648.         break;
  649.       case 57: /* plotter fonts */
  650.         plotter_fonts();
  651.         break;
  652.       case 58: /* bigfile "filename" */
  653.         readstr(ss);
  654.         strlwr(ss);        /* bit of a kludge but ... */
  655.         run_bigfile(ss);
  656.         break;
  657.       case 55: /* Postscrip fiename x y */
  658.         readstr(ss);
  659.             strlwr(ss);
  660.         readxy(x1,y1);
  661.         g_postscript(ss,x1,y1);
  662.         break;
  663.       case 32: /* PRINT */
  664.         break;
  665.       case 33: /* RBEZIER */
  666.         readxy(x1,y1);
  667.         readxy(x2,y2);
  668.         readxy(x3,y3);
  669.         g_get_xy(&ox,&oy);
  670.         x1 += ox;  x2 += ox;  x3 += ox;
  671.         y1 += oy;  y2 += oy;  y3 += oy;
  672.         g_bezier(x1,y1,x2,y2,x3,y3);
  673.         break;
  674.       case 34: /* REGION */
  675.         break;
  676.       case 50: /* RETURN exp */
  677.         readval(x);
  678.         sub_set_return(x);
  679.         break;
  680.       case 35: /* REVERSE */
  681.         g_reverse();
  682.         break;
  683.       case 36:  /* RLINE */
  684.         readval(x);
  685.         readval(y);
  686.         g_get_xy(&ox,&oy);
  687.         marrow = *(pcode + (cp++));
  688.         dbg gprint("RLINE getxy %f %f \n",ox,oy);
  689.         g_arrowline(x+ox,y+oy,marrow);
  690.         break;
  691.       case 37:  /* RMOVE */
  692.         readval(x);
  693.         readval(y);
  694.         g_get_xy(&ox,&oy);
  695.         g_move(x+ox,y+oy);
  696.         break;
  697.       case 38: /* ROTATE */
  698.         readval(x);
  699.         g_rotate(x);
  700.         break;
  701.       case 39: /* SAVE  name */
  702.         g_get_xy(&x,&y);
  703.         readval(z);
  704.         name_set(ostr,x,y,x,y);
  705.         break;
  706.       case 40: /* SCALE */
  707.         readxy(x,y);
  708.         g_scale(x,y);
  709.         break;
  710.       case 41: /* SET */
  711.         for (i=1;i<plen;i++) {
  712.         cp = i+1;
  713.         dbg gprint("set sub command %d \n",(*(pcode+i)-500));
  714.         switch (*(pcode+i)-500) {
  715.         /* FIDDLE CP SO THAT READVAL WORKS *** */
  716.           case 1: /* height */
  717.             readval(x);
  718.             g_set_hei(x);
  719.             break;
  720.           case 2: /* font */
  721.             readval(x);
  722.             memcpy(&both.l,&x,4);
  723.             g_set_font(both.l);
  724.             break;
  725.           case 3: /* justify */
  726.             readlong(jj);
  727.             g_set_just(jj);
  728.             break;
  729.           case 4: /* color */
  730.             readval(x);
  731.             memcpy(&both.l,&x,4);
  732.             g_set_color(both.l);
  733.             break;
  734.           case 5: /* dashlen */
  735.             readval(x);
  736.             g_set_line_styled(x);
  737.             break;
  738.           case 6: /* dash */
  739.             readval(x);
  740.             i = x;
  741.             sprintf(ss,"%d",i);
  742.             g_set_line_style(ss);
  743.             break;
  744.           case 7: /* lwidth */
  745.             readval(x);
  746.             g_set_line_width(x);
  747.             break;
  748.           case 10: /* fontlwidth */
  749.             readval(x);
  750.             g_set_font_width(x);
  751.             break;
  752.           case 8: /* join */
  753.             readlong(jj);
  754.             g_set_line_join(jj);
  755.             break;
  756.           case 9: /* cap */
  757.             readlong(jj);
  758.             g_set_line_cap(jj);
  759.             break;
  760.           default :
  761.             gprint("Not a valid set sub command {%d} i=%d \n",*(pcode+i),i);
  762.           }
  763.         i = cp-1;
  764.         }
  765.         break;
  766.       case 42: /* size x y [box]*/
  767.         readxy(x,y);
  768.         g_open(x,y);
  769.         g_get_xy(&ox,&oy);
  770.         done_open = true;
  771.         mask_just = *(pcode + cp++);
  772.         if (mask_just) { /* then draw box */
  773.             g_box_stroke(ox,oy,x,y);
  774.         }
  775.         break;
  776.       case 43: /* STROKE */
  777.         g_stroke();
  778.         break;
  779.       case 44: /* SUB */
  780.         readlong(jj);
  781.         sub_get_startend(jj,&i,&j);
  782.         *srclin = j;    /* skip past the subroutine */
  783.         break;
  784.       case 45: /* TEXT */
  785.         strcpy(ss,(char *) (pcode+cp));
  786.     /*    readstr(ss); */
  787.         g_text(ss);
  788.         g_get_bounds(&x1,&y1,&x2,&y2);
  789.  
  790.         break;
  791.       case 60: /* DEFMARKER */
  792.         break;
  793.       case 59: /* TEXTDEF */
  794.         strcpy(ss,(char *) (pcode+cp));
  795.         text_def(ss);
  796.         break;
  797.       case 46: /* TRANSLATE */
  798.         readxy(x,y);
  799.         g_translate(x,y);
  800.         break;
  801.       case 47: /* UNTIL */
  802.         readval(x);
  803.         if (!for_loop) loopadr[++nloop] = *srclin;
  804.         for_loop = true;
  805.         if (x) {for_skip = true; for_loop = false; nloop--;}
  806.         break;
  807.       case 48: /* WHILE */
  808.         break;
  809.       case 49: /* WRITE */
  810.         g_get_xy(&ox,&oy);
  811.         strcpy(ss2,"");
  812.         while (cp<plen) {
  813.             readlong(t);
  814.             if (t!=49) gprint("WRITE, PCODE ERROR, %d  cp %d plen %d\n",t,cp,plen);
  815.             readlong(t);
  816.             if (t==1) {
  817.                 readval(x);
  818.                 sprintf(ss,"%g ",x);
  819.             } else readstr(ss);
  820.             strcat(ss2,ss);
  821.         }
  822.         g_text(ss2);
  823.         g_move(ox,oy);
  824.         break;
  825.       default :
  826.         gprint("Not a recognized command \n");
  827.     }
  828.     *pend = cp;
  829. }
  830. /* should be in core.c */
  831. g_arrowline(double x2, double y2, int flag)
  832. {
  833.     double x1,y1;
  834.     if ((flag&3)==0) {
  835.         g_line(x2,y2);
  836.         return;
  837.     }
  838.     g_get_xy(&x1,&y1);
  839.     if (!can_fillpath) {
  840.         if (flag & 1)  g_arrow(x2-x1,y2-y1);
  841.         g_line(x2,y2);
  842.         if (flag & 2)  g_arrow(x1-x2,y1-y2);
  843.         return;
  844.     }
  845.     g_psarrow(x1,y1,x2,y2,flag);
  846. }
  847. g_psarrow(double x1, double y1, double x2, double y2, int flag)
  848. {
  849.     double ax1,ax2,ay1,ay2,dx,dy,nx,ny,nnx,nny,xx2,yy2;
  850.     int32 cur_color;
  851.     xx2 = x2; yy2 = y2;
  852.     dx = x2-x1;  dy = y2-y1;
  853.     g_arrowpoints(x1,y1,dx,dy,&ax1,&ay1,&ax2,&ay2,&nx,&ny);
  854.     g_set_path(true);
  855.     g_newpath();
  856.     if ((flag & 1)>0) {
  857.         g_move(ax2,ay2);
  858.         g_line(x1,y1);
  859.         g_line(ax1,ay1);
  860.         g_closepath();
  861.         x1 = nx; y1 = ny;
  862.     }
  863.      g_arrowpoints(x2,y2,-dx,-dy,&ax1,&ay1,&ax2,&ay2,&nx,&ny);
  864.     if ((flag & 2)>0) {
  865.         g_move(ax2,ay2);
  866.         g_line(x2,y2);
  867.         g_line(ax1,ay1);
  868.         g_closepath();
  869.         xx2 = nx; yy2 = ny;
  870.     }
  871.     g_get_color(&cur_color);
  872.     g_set_fill(cur_color);
  873.     g_fill();
  874.     g_set_path(false);
  875.     g_newpath();
  876.     g_move(x1,y1);
  877.     g_line(xx2,yy2);
  878.     g_move(x2,y2);
  879. }
  880. g_arrowpoints(double cx,double cy,double dx,double dy, double *ax1,
  881.     double *ay1,double *ax2,double *ay2, double *nnx, double *nny)
  882. {
  883.     double radius,angle,alen,nx,ny,width,arrow_angle;
  884.     g_get_line_width(&width);
  885.     if (width==0) width = .02;
  886.     arrow_angle = 10;
  887.     if (width>.1) arrow_angle = 20;
  888.     if (width>.3) arrow_angle = 30;
  889.     g_get_hei(&alen);  alen = alen/2;
  890.     if (sin(arrow_angle*3.14159/180)*alen < width/1.5) {
  891.         alen = (width/1.5) / sin(arrow_angle*3.141592/180);
  892.     }
  893.     xy_polar(dx,dy,&radius,&angle);
  894.     if (radius<0) alen = -alen;
  895.     polar_xy(alen,angle+arrow_angle,&dx,&dy);
  896.     *ax2 = cx+dx;  *ay2 = cy+dy;
  897.     polar_xy(alen,angle-arrow_angle,&dx,&dy);
  898.     *ax1 = cx+dx;  *ay1 = cy+dy;
  899.  
  900.     polar_xy(alen*cos(arrow_angle*3.141592/180),angle,&nx,&ny);
  901.     alen = width/2;
  902.     if (radius<0) alen = -alen;
  903.  
  904.     cx += nx; cy += ny;
  905.     *nnx = cx; *nny = cy;
  906. }
  907. g_arrow(double dx, double dy)
  908. {
  909.     double cx,cy,radius,angle,alen;
  910.     g_get_xy(&cx,&cy);
  911.     xy_polar(dx,dy,&radius,&angle);
  912.     g_get_hei(&alen);  alen = alen/2;
  913.     if (radius<0) alen = -alen;
  914.     polar_xy(alen,angle+10.0,&dx,&dy);
  915.     g_line(cx+dx,cy+dy);
  916.     g_move(cx,cy);
  917.     polar_xy(alen,angle-10.0,&dx,&dy);
  918.     g_line(cx+dx,cy+dy);
  919.     g_move(cx,cy);
  920. }
  921.  
  922. box_start(void)
  923. {
  924.     g_get_bounds(&box_x1[nbox],&box_y1[nbox],&box_x2[nbox],&box_y2[nbox]);
  925.     g_init_bounds();
  926.     nbox++;
  927.     box_add[nbox]  = 0;
  928.     box_fill[nbox] = 0;
  929.     box_name[nbox] = 0;
  930. }
  931. box_end(void)
  932. {
  933.     double x1,y1,x2,y2,ox,oy;
  934.     if (nbox==0) {
  935.         gprint("Too many end boxes \n");
  936.         return;
  937.     }
  938.     g_get_bounds(&x1,&y1,&x2,&y2);
  939.     if (x1>(x2+100)) {gprint("Empty box? %g %g ",x1,x2); return;}
  940.     x1 -= box_add[nbox];    y1 -= box_add[nbox];
  941.     x2 += box_add[nbox];    y2 += box_add[nbox];
  942.     g_get_xy(&ox,&oy);
  943.     if (box_fill[nbox]!=0) {
  944.         g_set_fill(box_fill[nbox]);
  945.         g_box_fill(x1,y1,x2,y2);
  946.     }
  947.     if (!box_nobox[nbox]) {
  948.         g_box_stroke(x1,y1,x2,y2);
  949.     }
  950.     if (box_name[nbox]!=0) {
  951.         name_set(box_name[nbox],x1,y1,x2,y2);
  952.         myfree(box_name[nbox]);
  953.     }
  954.     nbox--;
  955.     if (box_x1[nbox] <= box_x2[nbox]) {
  956.         g_set_bounds(box_x1[nbox],box_y1[nbox]);
  957.         g_set_bounds(box_x2[nbox],box_y2[nbox]);
  958.     }
  959.     g_move(ox,oy);
  960. }
  961. int nm_adjust(int jj,double *sx, double *sy, double ex, double ey,
  962.     double x1, double y1, double x2, double y2);
  963. int nm_point(int jj,double *rx, double *ry, double x1,double y1,double x2,double y2);
  964. int nm_split(char *s, char *n, char *p);
  965. name_join(char *o1,char *o2,int marrow)
  966. {
  967.     char n1[40],n2[40],p1[9],p2[9],*ss;
  968.     double ox,oy,sx,sy,ex,ey,x,y,x1,y1,x2,y2,x3,y3,x4,y4;
  969.     int i,jj1,jj2;
  970.  
  971.     strupr(o1);    strupr(o2);
  972.     if (strstr(o1,".H")!=0 || strstr(o1,".V")!=0) {
  973.         ss = o1; o1 = o2; o2 = ss;
  974.         if (marrow==2) marrow = 1;
  975.         else if (marrow==1) marrow = 2;
  976.     }
  977.     nm_split(o1,n1,p1);
  978.     nm_split(o2,n2,p2);
  979.  
  980.     x1 = 1e30; x3 = 1e30;
  981.     name_get(n1,&x1,&y1,&x2,&y2);
  982.     name_get(n2,&x3,&y3,&x4,&y4);
  983.     if (x1==1e30 || x3 == 1e30) return;
  984.     jj1 = pass_justify(p1);
  985.     jj2 = pass_justify(p2);
  986.  
  987.     nm_point(jj1,&sx,&sy,x1,y1,x2,y2);
  988.     ex = sx; ey = sy;
  989.     nm_point(jj2,&ex,&ey,x3,y3,x4,y4);
  990.  
  991.     nm_adjust(jj1,&sx,&sy,ex,ey,x1,y1,x2,y2);
  992.     nm_adjust(jj2,&ex,&ey,sx,sy,x3,y3,x4,y4);
  993.  
  994.     g_get_xy(&ox,&oy);
  995.     g_move(sx,sy);
  996.     if (marrow==2) marrow = 1;
  997.     else if (marrow==1) marrow = 2;
  998.     g_arrowline(ex,ey,marrow);
  999.  
  1000. /*     g_line(ex,ey);
  1001.     x = ex-sx;
  1002.     y = ey-sy;
  1003.     if (x!=0 || y!=0) {
  1004.         if (marrow & 1)  g_arrow(-x,-y);
  1005.         g_move(sx,sy);
  1006.         if (marrow & 2)  g_arrow(x,y);
  1007.         g_move(ox,oy);
  1008.  
  1009.  
  1010.     }
  1011.  
  1012. */
  1013. }
  1014. nm_point(int jj,double *rx, double *ry, double x1,double y1,double x2,double y2)
  1015. {
  1016.     int jx,jy;
  1017.     double w,y,d;
  1018.  
  1019.     if ((jj == 0x2000)) { /* virtical */
  1020.         if (y2<*ry) *ry = y2;
  1021.         if (y1>*ry) *ry = y1;
  1022.         return;
  1023.     }
  1024.     if ((jj == 0x3000)) { /* horizontal centre   */
  1025.         if (x2<*rx) *rx = x2;
  1026.         if (x1>*rx) *rx = x1;
  1027.         return;
  1028.     }
  1029.     jx = (jj & 0xf0) / 16;
  1030.     jy = jj & 0x0f;
  1031.     d = jx * (x2-x1)/2;
  1032.     *rx = x1 + d;
  1033.     d = jy * (y2-y1)/2;
  1034.     *ry = y1 + d;
  1035. }
  1036. nm_adjust(int jj,double *sx, double *sy, double ex, double ey,
  1037.     double x1, double y1, double x2, double y2)
  1038. {
  1039.     double r1,r2,xa,da,ca,dr,dx,dy,pi,rz,r;
  1040.     pi = 3.1415925;
  1041.     if ((jj & 0xf000)==0x5000) {
  1042.         r1 = (x2-x1)/2;
  1043.         r2 = (y2-y1)/2;
  1044.             xy_polar(*sx - ex,*sy - ey,&dr,&da);
  1045.         xa = da - 180;
  1046. xxxa:        if (xa > 180) xa = xa - 180;
  1047.         if (xa < 0) xa = xa + 180;
  1048.         if ((xa<0) || (xa> 180)) goto xxxa;
  1049.         if (r1==0) return;
  1050.         ca = atan(r2/r1)*180/pi;
  1051.         if (xa < 90) {
  1052.             rz = r1/cos(pi*xa/180);
  1053.             if (xa>ca) rz = r2/sin(pi*xa/180);
  1054.         } else {
  1055.             xa = xa - 90;
  1056.             rz = r2/cos(pi*xa/180);
  1057.             if (xa>(90-ca)) rz = r1/sin(pi*xa/180);
  1058.         }
  1059.         dr = dr - rz ;
  1060.         polar_xy(dr,da,&dx,&dy);
  1061.         *sx = ex + dx;
  1062.         *sy = ey + dy;
  1063.     }
  1064.     if ((jj & 0xff00)==0x1000) {
  1065.         r = (x2-x1)/2;
  1066.         xy_polar(*sx-ex,*sy-ey,&dr,&da);
  1067.         dr = dr - r;
  1068.         polar_xy(dr,da,&dx,&dy);
  1069.         *sx = ex + dx;
  1070.         *sy = ey + dy;
  1071.     }
  1072. }
  1073. nm_split(char *s, char *n, char *p)
  1074. {
  1075.     char *d;
  1076.     d = strchr(s,'.');
  1077.     if (d!=0) {
  1078.         ncpy(n,s,d-s);
  1079.         strcpy(p,d+1);
  1080.     } else {
  1081.         strcpy(n,s);
  1082.         strcpy(p,"BO");
  1083.     }
  1084. }
  1085.  
  1086. int f_getchan(void)
  1087. {
  1088.     int i;
  1089.     for (i=0; i<F_MAXCHAN; i++) {
  1090.         if (f_chan[i]==NULL) {
  1091.             return i;
  1092.         }
  1093.     }
  1094.     gprint("Fatal error, ran out of file handles, don't open so many\n");
  1095.     return 0;
  1096. }
  1097. void f_getline(int chn)
  1098. {
  1099.     char buff[1002];
  1100.     if (f_chan[chn]==NULL) {return;}
  1101.     if (f_read[chn]!=0) gprint("You cannot read from a file open for WRITe #%d %d \n",chn,f_read[chn]);
  1102.     if (fgets(buff,1000,f_chan[chn])==NULL) {
  1103.         f_end[chn] = true;
  1104.     }
  1105.     if (feof(f_chan[chn])) f_end[chn] = true;
  1106.     if (f_buff[chn]!=NULL) myfree(f_buff[chn]);
  1107.     f_buff[chn] = sdup(buff);
  1108. }
  1109. int f_eof(int chn)
  1110. {
  1111.     return f_end[chn];
  1112. }
  1113. char *f_gettok(int chn)
  1114. {
  1115.     static char thistok[80];
  1116.     if (f_end[chn]) gprint("Reading past end of file %d\n",chn);
  1117.     strcpy(thistok,f_nexttok[chn]);
  1118.     f_readahead(chn);
  1119.     return thistok;
  1120. }
  1121. void f_init()
  1122. {
  1123.     int i;
  1124.     for (i=0;i<F_MAXCHAN; i++) {
  1125.         if (f_chan[i] != NULL) {fclose(f_chan[i]); f_chan[i] = NULL;}
  1126.         siffree(&f_buff[i]);
  1127.         siffree(&f_nexttok[chn]);
  1128.     }
  1129. }
  1130. void f_readahead(chn)
  1131. {
  1132.     siffree(&f_nexttok[chn]);
  1133.     f_nexttok[chn] = sdup(f_getnext(chn));
  1134. }
  1135. char *f_getnext(int chn)
  1136. {
  1137.     char *s;
  1138.     int blen;
  1139.     static char tk[81];
  1140.     if (f_buff[chn]==NULL) f_getline(chn);
  1141.     tk[0] = 0;
  1142. try_again:
  1143.     if (f_buff[chn]==NULL) return tk;
  1144.     blen = strlen(f_buff[chn]);
  1145.     s = strtok(f_buff[chn]," ,=\t\n\x0a\x0c\x0d");
  1146.     if (s==NULL) goto next_line;
  1147.     strcpy(tk,s);
  1148.     if (strlen(s)==blen) f_buff[0] = 0;
  1149.     else strcpy(f_buff[chn],s+1+strlen(s));
  1150.     if (*s == '"' || *s == '!' || *s == ';') goto next_line;
  1151.     return tk;
  1152. next_line:
  1153.     if (f_eof(chn)) return tk;
  1154.     f_getline(chn);
  1155.     goto try_again;
  1156. }
  1157. void siffree(char **s)
  1158. {
  1159.     if (*s != NULL) myfree(*s);
  1160.     *s = NULL;
  1161. }
  1162. int f_testchan(int chn)
  1163. {
  1164.     if (chn<0 || chn>F_MAXCHAN) {
  1165.         gprint("Error in channel number %d\n",chn);
  1166.         return 0;
  1167.     }
  1168.     return chn;
  1169. }
  1170.  
  1171.